home *** CD-ROM | disk | FTP | other *** search
/ Aminet 3 / Aminet 3 - July 1994.iso / Aminet / dev / e / capus.lha / NasScreen / NasScreen.e < prev    next >
Encoding:
Text File  |  1994-05-02  |  26.2 KB  |  647 lines
  1. /********************************************************************************
  2.  * << AUTO HEADER XDME >>
  3.  ********************************************************************************
  4.  ED      "EDG"
  5.  EC      "EC"
  6.  PREPRO      "EPP"
  7.  SOURCE      "NasScreen.e"
  8.  EPPDEST     "NasScreen_EPP.e"
  9.  EXEC        "NasScreen"
  10.  ISOURCE     " "
  11.  HSOURCE     " "
  12.  ERROREC     " "
  13.  ERROREPP    " "
  14.  VERSION     "0"
  15.  REVISION    "12"
  16.  NAMEPRG     "NasScreen"
  17.  NAMEAUTHOR  "NasGûl"
  18.  ********************************************************************************
  19.  * HISTORY :
  20.  * V0.1    - Initial version (# MENU ITEM SUBI COMM STACK KEY).
  21.  * V0.11   - Ajout de SCREENMODE PALETTE FONT.
  22.  * v0.12   - Ajout du menu Build.
  23.  *******************************************************************************/
  24.  OPT OSVERSION=37
  25. ENUM ER_NONE,ER_OPENLIB,ER_WB,ER_VISUAL,ER_CONTEXT,ER_GADGET,ER_WINDOW,ER_MENUS,
  26.      ER_MEM,ER_BA,ER_SCREEN,ER_SIG
  27. MODULE 'intuition/intuition', 'gadtools', 'libraries/gadtools',
  28.        'intuition/gadgetclass', 'exec/nodes', 'intuition/screens',
  29.        'exec/lists','graphics/displayinfo' ,'graphics/text','gadtoolsbox/forms'
  30. MODULE 'utility','utility/tagitem','wb','workbench/startup','dos/dosextens'
  31. MODULE 'asl','libraries/asl','dos/dostags','dos/dosextens','diskfont'
  32. RAISE ER_MEM IF New()=NIL
  33. RAISE ER_MEM IF String()=NIL
  34. DEF new_screen=NIL:PTR TO screen,
  35.     visual=NIL,
  36.     wnd=NIL:PTR TO window,type,menu
  37. DEF sig=-1
  38. DEF tattr:PTR TO textattr      /* Texte Attibuts */
  39. DEF save_list[500]:LIST        /* Buffer contenant la description des menus (LONG) */
  40.                    /* ATTENTION une LIST stocke sur des LONG ou INT ou CHAR mais pas sur les 3  */
  41.                    /* la copie dans des structures newmenu se feras plus tard (PROC readfile()) */
  42. DEF com_list[500]:LIST         /* Liste Contenant les commandes associées aux menus */
  43. DEF stack_list[500]:LIST       /* Liste contenant les stacks associées aux commandes */
  44. DEF save_list_chip,total_chip      /* Emplacement réel des menus,total mémoire de réservé */
  45. DEF fichier_source[256]:STRING     /* string contenant le fichier de déscription des menus */
  46. DEF scr_type=HIRES_KEY         /* Type d'écran par défault */
  47. DEF scr_depth=2            /* Profondeur par défault   */
  48. DEF palette[4]:ARRAY OF INT    /* Palette de l'écran       */
  49. DEF dp=1,bp=2              /* detailpen et blockpen    */
  50. DEF all_pens
  51. PROC main() HANDLE /*"main()"*/
  52. /********************************************************************************
  53.  * Para     : NONE
  54.  * Return   : NONE
  55.  * Descritption : Main Procédure
  56.  *******************************************************************************/
  57.     DEF test_main
  58.     VOID {prg_banner}
  59.     tattr:=['topaz.font',9,0,0]:textattr
  60.     palette[0]:=$787
  61.     palette[1]:=$111
  62.     palette[2]:=$ABB
  63.     palette[3]:=$068
  64.     all_pens:=[0,1,1,2,1,3,1,0,2,1,2,1]:INT
  65.     /*************************************/
  66.     /* Initialisation des menus internes */
  67.     /*************************************/
  68.     ListCopy(save_list,[1,0,'NasGûl Menus',0,0,0,0,
  69.             2,0,'  Infos...  ',0,0,0,0,
  70.             2,0,'  NewShell  ',0,0,0,0,
  71.             2,0,'  Rebuild   ',0,0,0,0,
  72.             2,0,'  Quitter   ',0,0,0,0],35)
  73.     ListCopy(com_list,[0,0,0,0,0],5)
  74.     ListCopy(stack_list,[0,0,0,0,0],5)
  75.     StrCopy(fichier_source,arg,ALL)
  76.     /**********************************************************************/
  77.     /* readfile() renvoit FALSE si:                                       */
  78.     /* - le fichier est trop gros.                    */
  79.     /* - le fichier ne peut être ouvert.                  */
  80.     /* - une ligne du fichier ne contient aucun des mots suivants:    */
  81.     /*       - # en premier caractère (commentaires)                      */
  82.     /*       - MENU                           */
  83.     /*       - ITEM                           */
  84.     /*       - SUBI                           */
  85.     /*       - SCREENMODE                         */
  86.     /*       - PALETTE                            */
  87.     /**********************************************************************/
  88.     /* remakelist() reinitialise les menus internes                       */
  89.     /**********************************************************************/
  90.     IF (test_main:=readfile())=FALSE THEN remakelist()
  91.     IF (test_main:=openinterface())<>ER_NONE THEN Raise(test_main)
  92.     REPEAT
  93.     IF (test_main:=wait4message())<>ER_NONE THEN Raise(test_main)
  94.     UNTIL type=IDCMP_CLOSEWINDOW
  95.     Raise(ER_NONE)
  96. EXCEPT
  97.     closeinterface()
  98.     IF new_screen.firstwindow<>0
  99.     Wait(Shl(1,sig))            /* wait until all windows closed */
  100.     ENDIF
  101.     IF sig THEN FreeSignal(sig)
  102.     IF save_list_chip THEN FreeMem(save_list_chip,total_chip)
  103.     IF com_list THEN Dispose(com_list)
  104.     IF stack_list THEN Dispose(stack_list)
  105.     IF tattr THEN Dispose(tattr)
  106.     IF new_screen THEN CloseS(new_screen)
  107.     SetDefaultPubScreen(NIL)    /* workbench is default again */
  108.     SELECT exception
  109.     CASE ER_NONE;   NOP
  110.     CASE ER_OPENLIB; WriteF('Impossible d\aouvir les libraries gadtools.library et/ou asl.libraries\n')
  111.     CASE ER_SCREEN;  WriteF('Ouverture de l\aécran impossible.\n')
  112.     CASE ER_VISUAL;  WriteF('Impossible de "locker" l\aécran.\n')
  113.     CASE ER_MENUS;   WriteF('Impossible de créer les menus.\n')
  114.     CASE ER_WINDOW;  WriteF('Impossible d\aouvrir la fenêtre.\n')
  115.     CASE ER_MEM;     WriteF('Mémoire insuufisante.\n')
  116.     CASE ER_BA;  WriteF('Bad Args !.\n')
  117.     DEFAULT;     NOP
  118.     ENDSELECT
  119. ENDPROC
  120. PROC openinterface() /*"openinterface()"*/
  121. /********************************************************************************
  122.  * Para     : NONE
  123.  * Return   : ER_NONE si tout c'est bien passé,sinon l'erreur produite.
  124.  * Description  : Ouvre les libraries,Initialise l'écran et la fenêtre.
  125.  *******************************************************************************/
  126.   IF (gadtoolsbase:=OpenLibrary('gadtools.library',37))=NIL THEN RETURN ER_OPENLIB
  127.   IF (aslbase:=OpenLibrary('asl.library',37))=NIL THEN RETURN ER_OPENLIB
  128.   IF (new_screen:=OpenScreenTagList(NIL,          /* get ourselves a public screen */
  129.      [SA_TOP,0,
  130.       /*SA_WIDTH,1820,*/              /* la taille de l'écran ne se fait qu'avec */
  131.       /*SA_HEIGHT,512,*/              /*                         */
  132.       SA_DEPTH,scr_depth,             /*                         */
  133.       SA_FONT,tattr,              /*                         */
  134.       SA_DISPLAYID,scr_type,          /* le champ SA_DISPLAYID           */
  135.       SA_PUBNAME,'NGLSCREEN',
  136.       SA_TITLE,'NasGûl Screen © 1994 NasGûl',
  137.       SA_PUBSIG,IF (sig:=AllocSignal(-1))=NIL THEN Raise(ER_SIG) ELSE sig,
  138.       SA_AUTOSCROLL,TRUE,
  139.       SA_TYPE,CUSTOMSCREEN+PUBLICSCREEN,
  140.       SA_OVERSCAN,OSCAN_TEXT,
  141.       /*SA_PENS,[0,1,1,2,1,3,1,0,2,1,2,1]:INT,    /* Répartition de couleurs WB 2.0 */*/
  142.       SA_PENS,all_pens,
  143.       SA_DETAILPEN,dp,            /* Detailpen */
  144.       SA_BLOCKPEN,bp,             /* BlockPen  */
  145.       0,0]))=NIL THEN RETURN ER_SCREEN
  146.   PubScreenStatus(new_screen,0)                 /* make it available */
  147.   SetDefaultPubScreen('NGLSCREEN')
  148.   SetPubScreenModes(SHANGHAI)
  149.   IF (visual:=GetVisualInfoA(new_screen,NIL))=NIL THEN RETURN ER_VISUAL
  150.   IF (menu:=CreateMenusA(save_list_chip,NIL))=NIL THEN RETURN ER_MENUS
  151.   IF LayoutMenusA(menu,visual,NIL)=FALSE THEN RETURN ER_MENUS
  152.   IF (wnd:=OpenW(0,0,new_screen.width,new_screen.height,$700,$900,'NGLWINDOW',new_screen,15,NIL))=NIL THEN RETURN ER_WINDOW
  153.   LoadRGB4(ViewPortAddress(wnd),palette,4)
  154.   IF SetMenuStrip(wnd,menu)=FALSE THEN RETURN ER_MENUS
  155.   Gt_RefreshWindow(wnd,NIL)
  156.   RETURN ER_NONE
  157. ENDPROC
  158. PROC closeinterface() /*"closeinterface()"*/
  159. /********************************************************************************
  160.  * Para     : NONE
  161.  * Return   : NONE
  162.  * Descritption : Ferme l'écran la fenêtre et les libraries.
  163.  *******************************************************************************/
  164.   IF wnd THEN ClearMenuStrip(wnd)
  165.   IF menu THEN FreeMenus(menu)
  166.   IF visual THEN FreeVisualInfo(visual)
  167.   IF wnd THEN CloseWindow(wnd)
  168.   IF gadtoolsbase THEN CloseLibrary(gadtoolsbase)
  169.   IF aslbase THEN CloseLibrary(aslbase)
  170. ENDPROC
  171. PROC wait4message() HANDLE /*"wait4message()"*/
  172. /********************************************************************************
  173.  * Para     : NONE
  174.  * Return   : ER_NONE ou l'erreur apparue lors d'un Rebuild (menus).
  175.  * Descritption : Surveille la fenêtre.
  176.  *******************************************************************************/
  177.   DEF mes:PTR TO intuimessage,ms
  178.   DEF ret=NIL,adr_menu:PTR TO menu,number
  179.   DEF fwin:PTR TO window
  180.   ms:=wnd.menustrip
  181.   REPEAT
  182.     type:=0
  183.     IF mes:=Gt_GetIMsg(wnd.userport)
  184.       type:=mes.class
  185.       IF type=IDCMP_MENUPICK
  186.       ret:=mes.code
  187.       IF ret<>$FFFF
  188.           adr_menu:=ItemAddress(ms,ret)
  189.           SELECT ret
  190.           CASE $F800 /*Infos*/
  191.               EasyRequestArgs(0,[20,0,0,'NasGûl Screen v0.0a','Ok'],0,NIL)
  192.           CASE $F820 /*newshell*/
  193.               Execute('Newshell',0,stdout)
  194.              all_pens:=[1,2,1,2,0,1,3,1,2,1,1,0]:INT
  195.           CASE $F840 /*rebuild*/
  196.               /*Raise(rebuildmenu(fichier_source))*/
  197.               Raise(rebuildmenu())
  198.           CASE $F860 /*quitter*/
  199.               fwin:=new_screen.firstwindow
  200.               IF fwin.nextwindow=0
  201.               IF EasyRequestArgs(0,[20,0,0,'Voulez-vous quitter ?','Oui|Non'],0,NIL) THEN type:=IDCMP_CLOSEWINDOW
  202.               ELSE
  203.               IF EasyRequestArgs(0,[20,0,0,'Attention plusieurs fenêtres sur l\aécran.\n Voulez-vous quitter ?','Oui|Non'],0,NIL) THEN type:=IDCMP_CLOSEWINDOW
  204.               ENDIF
  205.           DEFAULT
  206.               number:=executemenu(ms,adr_menu)
  207.           ENDSELECT
  208.       ENDIF
  209.       ELSEIF type=IDCMP_REFRESHWINDOW
  210.     Gt_BeginRefresh(wnd)
  211.     Gt_EndRefresh(wnd,TRUE)
  212.     type:=0
  213.       ELSEIF type<>IDCMP_CLOSEWINDOW
  214.     type:=0
  215.       ENDIF
  216.       Gt_ReplyIMsg(mes)
  217.     ELSE
  218.       Wait(-1)
  219.     ENDIF
  220.   UNTIL type
  221.   Raise(ER_NONE)
  222. EXCEPT
  223.     RETURN exception
  224. ENDPROC
  225. PROC readfile() /*"readfile()"*/
  226. /********************************************************************************
  227.  * Para     : NONE
  228.  * Return   : TRUE si tout c'est bien passé,sion FALSE
  229.  * Descritption : Ouvre le fichier de config et le traite ligne par ligne.
  230.  *******************************************************************************/
  231.   DEF len,a,adr,buf,handle,flen=TRUE,long,pas
  232.   DEF my_string[256]:STRING,p=0,ff[256]:STRING
  233.   DEF my_menu:PTR TO newmenu,test_parsing=NIL
  234.   /*****************************************/
  235.   /* Stockage du fichier source dans buf   */
  236.   /*****************************************/
  237.   IF (flen:=FileLength(fichier_source))=-1 THEN RETURN FALSE
  238.   IF (buf:=New(flen+1))=NIL THEN RETURN FALSE
  239.   IF (handle:=Open(fichier_source,1005))=NIL THEN RETURN FALSE
  240.   len:=Read(handle,buf,flen)
  241.   Close(handle)
  242.   IF len<1 THEN RETURN FALSE
  243.   adr:=buf
  244.   /***********/
  245.   /* Lecture */
  246.   /***********/
  247.   FOR a:=0 TO len-1
  248.     test_parsing:=NIL
  249.     IF buf[a]=10                /* Retour chariot (on traite le fichier par ligne) */
  250.     IF a-p<>0               /* si la ligne n'est pas vide ..*/
  251.         StringF(my_string,'\s',adr)     /* stockage de la ligne dans ff */
  252.         ff:=String(EstrLen(my_string))
  253.         StrCopy(ff,my_string,a-p)
  254.         IF (test_parsing:=parse(ff))=FALSE  /* parsing de ff */
  255.         Dispose(buf)
  256.         RETURN FALSE
  257.         ENDIF
  258.     ENDIF
  259.     p:=a+1
  260.     adr:=buf+a+1
  261.     ENDIF
  262.   ENDFOR
  263.   Dispose(buf)                            /* libére la mémoire buffer du fichier_source */
  264.   ListAdd(save_list,[0,0,0,0,0,0,0],7)    /* ajoute le END_MENU (0)  a la liste des menus */
  265.   long:=ListLen(save_list)                /* longueur de la  liste qui sert a calculer */
  266.   total_chip:=(long/7)*20                 /* la place que prennent les structures newmenu */
  267.   save_list_chip:=AllocMem(total_chip,2)  /* on alloue la place néssessaire */
  268.   pas:=save_list_chip
  269.   FOR buf:=0 TO long-1 STEP 7
  270.     my_menu:=New(SIZEOF newmenu)             /* création */
  271.     my_menu.type:=save_list[buf]         /* stockage */
  272.     my_menu.pad:=save_list[buf+1]        /*    "     */
  273.     my_menu.label:=save_list[buf+2]      /*    "     */
  274.     my_menu.commkey:=save_list[buf+3]    /*    "     */
  275.     my_menu.flags:=save_list[buf+4]      /*    "     */
  276.     my_menu.mutualexclude:=save_list[buf+5]  /*    "     */
  277.     my_menu.userdata:=save_list[buf+6]   /*    "     */
  278.     CopyMem(my_menu,pas,20)                  /* Copie en mémoire */
  279.     pas:=pas+20              /* incrémentation par pas de 20 */
  280.     Dispose(my_menu)                         /* libération du buffer my_menu */
  281.   ENDFOR
  282.   /*******************/
  283.   /* FIN DE LA COPIE */
  284.   /*******************/
  285.   Dispose(save_list)   /* libération de buffer */
  286.   RETURN TRUE
  287. ENDPROC
  288. PROC parse(ff) /*"parse(ff)"*/
  289. /********************************************************************************
  290.  * Para     : Chaine de caractères.
  291.  * Return   : TRUE si tout c'set bien passé,sion FALSE
  292.  * Description  : Stock la ligne dans save_list.
  293.  *******************************************************************************/
  294.     DEF ret_str[256]:STRING
  295.     DEF trim_str[256]:STRING
  296.     DEF parse_str[256]:STRING
  297.     DEF str_para[256]:STRING
  298.     trim_str:=TrimStr(ff)
  299.     IF StrCmp('#',ff,1)<>TRUE                                        /* si ce n'est pas un commentaire.. */
  300.     StrCopy(parse_str,trim_str,ALL)
  301.     IF StrCmp('SCREENMODE',parse_str,10)
  302.         initscreen(parse_str)
  303.         RETURN TRUE
  304.     ENDIF
  305.     IF StrCmp('PALETTE',parse_str,7)
  306.         initpalette(parse_str)
  307.         RETURN TRUE
  308.     ENDIF
  309.     IF StrCmp('MENU',parse_str,4)=TRUE                           /* Entrée Menu */
  310.         IF (ret_str:=found_para('MENU',parse_str))<>FALSE        /* Trouve le titre */
  311.         str_para:=String(EstrLen(ret_str))
  312.         StrCopy(str_para,ret_str,ALL)
  313.         ListAdd(save_list,[1,0,str_para,0,0,0,0],7)          /* stockage dans la liste */
  314.         ListAdd(com_list,[''],1)                             /* mise a jour des autres listes */
  315.         ListAdd(stack_list,[''],1)
  316.         Dispose(str_para)                                    /* libère mem */
  317.         ENDIF
  318.         RETURN TRUE                          /* LIGNE OK */
  319.     ELSEIF StrCmp('ITEM',parse_str,4)=TRUE                       /* Entrée Item */
  320.         IF (ret_str:=found_para('ITEM',parse_str))<>FALSE        /* Trouve le nom */
  321.         str_para:=String(EstrLen(ret_str))
  322.         StrCopy(str_para,ret_str,ALL)
  323.         ListAdd(save_list,[2,0,str_para],3)                  /* stockage dans la liste */
  324.         Dispose(str_para)
  325.         IF (ret_str:=found_para('KEY',parse_str))<>FALSE     /* Trouve le raccourci clavier */
  326.             str_para:=String(EstrLen(ret_str))
  327.             StrCopy(str_para,ret_str,ALL)
  328.             ListAdd(save_list,[str_para,0,0,0],4)            /* stockage dans la liste */
  329.             Dispose(str_para)                                /* libère la mémoire */
  330.         ELSE
  331.             ListAdd(save_list,[0,0,0,0],4)                   /* pas de raccourci clavier */
  332.         ENDIF
  333.         IF (ret_str:=found_para('COMM',parse_str))<>FALSE    /* trouve la commande associée */
  334.             str_para:=String(EstrLen(ret_str))
  335.             StrCopy(str_para,ret_str,ALL)
  336.             ListAdd(com_list,[str_para],1)                   /* stockage dans la liste */
  337.             Dispose(str_para)
  338.         ELSE
  339.             ListAdd(com_list,[''],1)                         /* item sans commande,donc c'est un item */
  340.         ENDIF                            /* avec subitem                  */
  341.         IF (ret_str:=found_para('STACK',parse_str))<>FALSE   /* trouve la stack */
  342.             str_para:=String(EstrLen(ret_str))
  343.             StrCopy(str_para,ret_str,ALL)
  344.             ListAdd(stack_list,[str_para],1)                 /* stockage dans la liste */
  345.             Dispose(str_para)
  346.         ELSE
  347.             ListAdd(stack_list,['4000'],1)                   /* stack par défault a 4000 */
  348.         ENDIF
  349.         ENDIF
  350.         RETURN TRUE                          /* LIGNE OK */
  351.     ELSEIF StrCmp('SUBI',parse_str,4)=TRUE                       /* Entrée SubItem */
  352.         IF (ret_str:=found_para('SUBI',parse_str))<>FALSE        /* Trouve le nom */
  353.         str_para:=String(EstrLen(ret_str))
  354.         StrCopy(str_para,ret_str,ALL)
  355.         ListAdd(save_list,[3,0,str_para],3)                  /* Stockage */
  356.         Dispose(str_para)                                    /* FreeMem  */
  357.         IF (ret_str:=found_para('KEY',parse_str))<>FALSE     /* Raccourci clavier */
  358.             str_para:=String(EstrLen(ret_str))
  359.             StrCopy(str_para,ret_str,ALL)
  360.             ListAdd(save_list,[str_para,0,0,0],4)            /* stockage */
  361.             Dispose(str_para)
  362.         ELSE
  363.             ListAdd(save_list,[0,0,0,0],4)                   /* pas de raccourci clavier */
  364.         ENDIF
  365.         IF (ret_str:=found_para('COMM',parse_str))<>FALSE    /* Trouve commande associée */
  366.             str_para:=String(EstrLen(ret_str))
  367.             StrCopy(str_para,ret_str,ALL)
  368.             ListAdd(com_list,[str_para],1)                   /* stockage */
  369.             Dispose(str_para)
  370.         ELSE
  371.             ListAdd(com_list,[''],1)                         /* pas de commande */
  372.         ENDIF
  373.         IF (ret_str:=found_para('STACK',parse_str))<>FALSE   /* Trouve la stack */
  374.             str_para:=String(EstrLen(ret_str))
  375.             StrCopy(str_para,ret_str,ALL)
  376.             ListAdd(stack_list,[str_para],1)                 /* Stockage */
  377.             Dispose(str_para)
  378.         ELSE
  379.             ListAdd(stack_list,['4000'],1)                   /* Stack par défault de 4000 */
  380.         ENDIF
  381.         ENDIF
  382.         RETURN TRUE                          /* LIGNE OK */
  383.     ENDIF
  384.     ELSE
  385.     RETURN TRUE                          /* LIGNE COMMENTAIRE OK */
  386.     ENDIF
  387.     RETURN FALSE                             /* PROBLEME AUCUN #,MENU,ITEM,SUBI DANS CETTE LIGNE */
  388. ENDPROC
  389. PROC found_para(str_para,parse_str) /*"found_para(str_para,parse_str)"*/
  390. /********************************************************************************
  391.  * Para     : Mot clé,ligne
  392.  * Return   : la chaine résultante ou FALSE.
  393.  * Description  : Retourne le paramètre d'un Mot Clé.
  394.  *        Ex
  395.  *        found_para('MACHIN','BIDULE "je suis un bidule" TRUC "je suis un truc" MACHIN "je suis un machin"')
  396.  *        Auras en retour je suis un machin
  397.  *******************************************************************************/
  398.     DEF p[256]:STRING,pos_dep,pos_fin
  399.     pos_dep:=InStr(parse_str,str_para,0)
  400.     IF pos_dep<>-1
  401.     pos_dep:=InStr(parse_str,'"',pos_dep)
  402.     pos_fin:=InStr(parse_str,'"',pos_dep+1)
  403.     MidStr(p,parse_str,pos_dep+1,(pos_fin-pos_dep)-1)
  404.     RETURN p
  405.     ELSE
  406.     RETURN FALSE
  407.     ENDIF
  408. ENDPROC
  409. PROC executemenu(ms,adr_menu) /*"executemenu(ms,adr_menu)"*/
  410. /********************************************************************************
  411.  * Para     : adr menustrip,adr item
  412.  * Return   : NONE
  413.  * Description  : Compte les menus et execute la commande associée
  414.  *******************************************************************************/
  415.     DEF look_menu:PTR TO menu
  416.     DEF look_item:PTR TO menuitem
  417.     DEF look_subitem:PTR TO menuitem
  418.     DEF look_itext:PTR TO intuitext
  419.     DEF adr
  420.     DEF count=0
  421.     DEF exe_str[256]:STRING,exe_stack
  422.     look_menu:=ms
  423.     adr:=adr_menu
  424.     WHILE look_menu
  425.     IF look_menu.firstitem<>0
  426.         look_item:=look_menu.firstitem
  427.         count:=count+1
  428.         WHILE look_item
  429.         IF look_item=adr
  430.             JUMP found_exec
  431.         ENDIF
  432.         count:=count+1
  433.         look_itext:=look_item.itemfill         /* Structure Intuitext (texte du menu) */
  434.         IF look_item.subitem<>0
  435.             look_subitem:=look_item.subitem
  436.             WHILE look_subitem
  437.             IF look_subitem=adr
  438.                 JUMP found_exec
  439.             ENDIF
  440.             count:=count+1
  441.             look_itext:=look_subitem.itemfill
  442.             look_subitem:=look_subitem.nextitem
  443.             ENDWHILE
  444.         ENDIF
  445.         look_item:=look_item.nextitem
  446.         ENDWHILE
  447.     ENDIF
  448.     look_menu:=look_menu.nextmenu
  449.     ENDWHILE
  450.     found_exec:
  451.     StrCopy(exe_str,com_list[count],ALL)
  452.     exe_stack:=Val(stack_list[count],NIL)
  453.     SystemTagList(exe_str,[SYS_OUTPUT,NIL,
  454.                       SYS_INPUT,NIL,
  455.                       SYS_ASYNCH,TRUE,
  456.                       SYS_USERSHELL,TRUE,
  457.                       NP_STACKSIZE,exe_stack,
  458.                       NP_PRIORITY,0,
  459.                       NP_PATH,NIL,
  460.                       NP_CONSOLETASK,NIL,
  461.                       TAG_DONE])
  462. ENDPROC
  463. PROC remakelist() /*"remakelist()"*/
  464. /********************************************************************************
  465.  * Para     : NONE
  466.  * Return   : NONE
  467.  * Description  : Erreur dans le fichier de config,on ne reconstruit que les
  468.  *        menus par défaut.
  469.  *******************************************************************************/
  470.     DEF my_menu:PTR TO newmenu
  471.     DEF pas,long,buf
  472.     EasyRequestArgs(0,[20,0,0,'Error Found in config. file','Ok'],0,NIL)
  473.     /******************/
  474.     /* On efface tout */
  475.     /******************/
  476.     IF save_list THEN Dispose(save_list)
  477.     IF com_list THEN Dispose(com_list)
  478.     IF stack_list THEN Dispose(stack_list)
  479.     /*******************************************/
  480.     /* Et on initialise que les menus internes */
  481.     /*******************************************/
  482.     ListCopy(save_list,[1,0,'NasGûl Menus',0,0,0,0,
  483.               2,0,'  Infos...  ',0,0,0,0,
  484.               2,0,'  NewShell  ',0,0,0,0,
  485.               2,0,'  Rebuild   ',0,0,0,0,
  486.               2,0,'  Quitter   ',0,0,0,0],35)
  487.     ListCopy(com_list,[0,0,0,0,0],5)
  488.     ListCopy(stack_list,[0,0,0,0,0],5)
  489.     ListAdd(save_list,[0,0,0,0,0,0,0],7)
  490.     long:=ListLen(save_list)
  491.     total_chip:=(long/7)*20
  492.     save_list_chip:=AllocMem(total_chip,2)
  493.     pas:=save_list_chip
  494.     FOR buf:=0 TO long-1 STEP 7
  495.       my_menu:=New(SIZEOF newmenu)
  496.       my_menu.type:=save_list[buf]
  497.       my_menu.pad:=save_list[buf+1]
  498.       my_menu.label:=save_list[buf+2]
  499.       my_menu.commkey:=save_list[buf+3]
  500.       my_menu.flags:=save_list[buf+4]
  501.       my_menu.mutualexclude:=save_list[buf+5]
  502.       my_menu.userdata:=save_list[buf+6]
  503.       CopyMem(my_menu,pas,20)
  504.       pas:=pas+20
  505.       Dispose(my_menu)
  506.     ENDFOR
  507.     Dispose(save_list)
  508. ENDPROC
  509. PROC initscreen(parse_str) /*"initscreen(parse_str)"*/
  510. /********************************************************************************
  511.  * Para     : Chaine de caractères
  512.  * Return   : NONE
  513.  * Description  : Lecture de la ligne SCREENMODE du fichier de config.
  514.  *******************************************************************************/
  515.     DEF valeur[256]:STRING
  516.     DEF font_name[80]:STRING,font_size[2]:STRING,pos_f=NIL
  517.     DEF new_tattr:PTR TO textattr
  518.     IF (valeur:=found_para('MODE',parse_str))<>FALSE
  519.     IF StrCmp('SHRE',valeur,4)
  520.         scr_type:=SUPERLACE_KEY
  521.         JUMP ok
  522.     ENDIF
  523.     IF StrCmp('SHR',valeur,3)
  524.         scr_type:=SUPER_KEY
  525.         JUMP ok
  526.     ENDIF
  527.     IF StrCmp('HRE',valeur,3)
  528.         scr_type:=HIRESLACE_KEY
  529.         JUMP ok
  530.     ENDIF
  531.     IF StrCmp('BRE',valeur,3)
  532.         scr_type:=LORESLACE_KEY
  533.         JUMP ok
  534.     ENDIF
  535.     IF StrCmp('BR',valeur,2)
  536.         scr_type:=LORES_KEY
  537.         JUMP ok
  538.     ENDIF
  539.     IF StrCmp('HR',valeur,2)
  540.         scr_type:=HIRES_KEY
  541.         JUMP ok
  542.     ENDIF
  543.     ENDIF
  544.     ok:
  545.     IF (valeur:=found_para('TYPE',parse_str))<>FALSE
  546.     IF StrCmp('PAL',valeur,3)
  547.         scr_type:=scr_type+PAL_MONITOR_ID
  548.         JUMP ok1
  549.     ENDIF
  550.     IF StrCmp('NTSC',valeur,4)
  551.         scr_type:=scr_type+NTSC_MONITOR_ID
  552.         JUMP ok1
  553.     ENDIF
  554.     ENDIF
  555.     ok1:
  556.     IF (valeur:=found_para('DEPTH',parse_str))<>FALSE
  557.     scr_depth:=Val(valeur,NIL)
  558.     ENDIF
  559.     IF (valeur:=found_para('DP',parse_str))<>FALSE
  560.     dp:=Val(valeur,NIL)
  561.     ENDIF
  562.     IF (valeur:=found_para('BP',parse_str))<>FALSE
  563.     bp:=Val(valeur,NIL)
  564.     ENDIF
  565.     IF (valeur:=found_para('FONT',parse_str))<>FALSE
  566.     pos_f:=InStr(valeur,'/',0)
  567.     MidStr(font_name,valeur,0,pos_f)
  568.     MidStr(font_size,valeur,pos_f+1,ALL)
  569.     IF tattr THEN Dispose(tattr)
  570.     new_tattr:=New(SIZEOF textattr)
  571.     new_tattr.name:=String(EstrLen(font_name))
  572.     StrCopy(new_tattr.name,font_name,ALL)
  573.     new_tattr.ysize:=Val(font_size,NIL)
  574.     new_tattr.style:=0
  575.     new_tattr.flags:=0
  576.     tattr:=new_tattr
  577.     ENDIF
  578. ENDPROC
  579. PROC initpalette(parse_str) /*"initpalette()"*/
  580. /********************************************************************************
  581.  * Para     : Chaine de caractères.
  582.  * Return   : NONE
  583.  * Description  : Lecture de la ligne PALETTE de fichier de config.
  584.  *******************************************************************************/
  585.     DEF rgb[4]:STRING,r_g_b
  586.     IF (rgb:=found_para('COL0',parse_str))<>FALSE
  587.     r_g_b:=Val(rgb,NIL)
  588.     palette[0]:=r_g_b
  589.     ENDIF
  590.     IF (rgb:=found_para('COL1',parse_str))<>FALSE
  591.     r_g_b:=Val(rgb,NIL)
  592.     palette[1]:=r_g_b
  593.     ENDIF
  594.     IF (rgb:=found_para('COL2',parse_str))<>FALSE
  595.     r_g_b:=Val(rgb,NIL)
  596.     palette[2]:=r_g_b
  597.     ENDIF
  598.     IF (rgb:=found_para('COL3',parse_str))<>FALSE
  599.     r_g_b:=Val(rgb,NIL)
  600.     palette[3]:=r_g_b
  601.     ENDIF
  602. ENDPROC
  603. PROC rebuildmenu() /*"rebuildmenu()"*/
  604. /********************************************************************************
  605.  * Para     : NONE.
  606.  * Return   : ER_NONE si Ok,sinon l'erreur.
  607.  * Description  : Libère la mémoire des menus,ferme la fenêtre,et reload le
  608.  *        fichier de config.
  609.  *******************************************************************************/
  610.     DEF test_cleanup
  611.     /* <<<< CLEANUP >>>> */
  612.     IF save_list_chip THEN FreeMem(save_list_chip,total_chip)
  613.     IF com_list THEN Dispose(com_list)
  614.     IF stack_list THEN Dispose(stack_list)
  615.     IF wnd THEN ClearMenuStrip(wnd)
  616.     IF menu THEN FreeMenus(menu)
  617.     IF wnd THEN CloseWindow(wnd)
  618.     /* Palette par défault */
  619.     palette[0]:=$787
  620.     palette[1]:=$111
  621.     palette[2]:=$ABB
  622.     palette[3]:=$068
  623.     /*************************************/
  624.     /* Initialisation des menus internes */
  625.     /*************************************/
  626.     ListCopy(save_list,[1,0,'NasGûl Menus',0,0,0,0,
  627.             2,0,'  Infos...  ',0,0,0,0,
  628.             2,0,'  NewShell  ',0,0,0,0,
  629.             2,0,'  Rebuild   ',0,0,0,0,
  630.             2,0,'  Quitter   ',0,0,0,0],35)
  631.     ListCopy(com_list,[0,0,0,0,0],5)
  632.     ListCopy(stack_list,[0,0,0,0,0],5)
  633.     /* On charge le fichier */
  634.     IF (test_cleanup:=readfile())=FALSE THEN remakelist()
  635.     IF (menu:=CreateMenusA(save_list_chip,NIL))=NIL THEN RETURN ER_MENUS
  636.     IF LayoutMenusA(menu,visual,NIL)=FALSE THEN RETURN ER_MENUS
  637.     IF (wnd:=OpenW(0,0,new_screen.width,new_screen.height,$700,$190E,'NGLWINDOW',new_screen,15,NIL))=NIL THEN RETURN ER_WINDOW
  638.     LoadRGB4(ViewPortAddress(wnd),palette,4)
  639.     IF SetMenuStrip(wnd,menu)=FALSE THEN RETURN ER_MENUS
  640.     new_screen.font:=tattr
  641.     Gt_RefreshWindow(wnd,NIL)
  642.     RETURN ER_NONE
  643. ENDPROC
  644. prg_banner:
  645. INCBIN 'NasScreen.header'
  646.  
  647.